perm filename MARKZ.F4[NEW,LCS]2 blob
sn#383518 filedate 1978-09-26 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 C**** MARKZ -- XREAD (FOR MARKZ,SLURZ) -- ZNOTE -- MARKS
C00015 ENDMK
C⊗;
C**** MARKZ -- XREAD (FOR MARKZ,SLURZ) -- ZNOTE -- MARKS
SUBROUTINE MARKZ
COMMON /XRN/RN(1)
1 /RINP/R(10,85),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
1 NOSET,STEM,STUP,NTC,PS2,RAM,RDD,IT,POS /ALF/INP(72),ML
1 /LIMIT/LIMIT,ITEM,LL,IS,IX
1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
1 /SCX/JALPHA(7),ISTAR,JAL(22),JX,U,JZ,IRHY,JD,KA,KB,IZ
1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
1 ,JXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
INVT=-1
JNTC=NTC-1
C JNTC=NUM OF NTS NOW
JREP=-1
C JREP IS FOR REPEAT FEATURE IN 'MARKS'
25 CALL XREAD
505 L=0
K=0
POS=-10.
5032 IF(N.LE.JNTC)GO TO 5030
N=JNTC
C TRAPS ERROR OF TRYING TO PUT MARK ON NON-EXISTENT NOTE.
VX(J)=N
C VX(J)=N IS NEEDED AT LABEL 130
5030 L=L+1
502 K=K+1
IF(R(1,K).NE.1.)GO TO 502
C IS IT A NOTE?
P=R(3,K)
IF(P.EQ.POS)GO TO 502
C SKIPS DBLSTPS
POS=P
506 IF(L.LT.N)GO TO 5030
30 IF(JREP)CALL MARKS(RA)
RB=0
J=J+1
IF(RA.GE.30.AND.RA.LE.35)VX(J+1)=0
C THIS ↑↑↑↑ CATCHES FINGERING NUM.(0-5) IT WAS READ IN MARKS.
IF(RA.EQ.99)RA=VX(J)
C IF STEM IS DOWN OR THERE ARE NOTES BELOW(DBL STP), POSITION
C OF ACCENT WILL BE INVERTED.
130 IF(RA.LT.37)GO TO 304
C 37=RIT.
C=POSIT(VX(J-1))
IF(RA.LE.60.OR.RA.GT.63)GO TO 308
C NEXT FOR TREMOLO: TM, TME, TMS, =32ND, 8TH, 16TH
NN=11
A=8
C A IS WDCNT-2
B=6
C CODE NUM. IS IN B
CXCX C=C+1.5
C FIND POSITION OF THIS NOTE
BB=R(4,K)
C BB=HEIGHT
RC=AMOD(R(7,K),10.0)
C LOOK FOR TAILS
X=0
IF(RA.EQ.61)X=1
C RA=61= 8TH NOTE BEAM
AA=R(8,K)
C TREM. POS. WILL DEPEND ON NOTE POS. AND STEM LENGTH
IF(AA.NE.0)GO TO 2309
AA=1-X
R(8,K)=1.2-X
2309 AA=AA-1
C AA = AMOUNT TO BE ADDED OR SUBTRACTED WITH HEIGHT OF NOTE
IF(R(5,K).GE.20)GO TO 1309
C CHECK ON STEM DIRECTION
X=-(RA-50)
C MAKES -11, -12, -13, ETC.
IF(RC.NE.0)BB=BB-2
GO TO 309
1309 X=-(RA-40)
C MAKES -21, -22, ETC.
AA=-AA
IF(RC.NE.0)BB=BB+2
309 BB=BB+AA
C OK FOR 16TH AND 32ND - BUT 8TH NEEDS MORE WORK******
RC=0
RN(IS+9)=0
RN(IS+10)=0
C ABOVE IS TO LEAVE ROOM FOR CHANGE OF TREM TO BE PARALLEL TO OTHER BM.
GO TO 305
308 IF(RA.LT.100)C=C-1.5
C '-1.5' PUSHES IT TO LEFT. MAYBE CHANGE ORIGINAL POSITIONS??
NN=6
RC=RA
BB=-6
A=3
B=3
IF(XNOTE(K).LT.3)BB=XNOTE(K)-7.5
C LOWERS ITEM IF NOTE BELOW STAFF. BUT IS 'K' ALWAYS OK HERE??????
IF(RA.LT.99)GO TO 305
C NEXT FOR CRESC. & DECRSC. LINES<,>. TYPE /NT1 C+ NT2/ OR /N1.d C- N2.d/
C ALSO FOR "8va ----" /NT1 O NT2/
NN=8
BB=BB+2.5
A=5
B=4
RB=50
IF(RA.NE.208)GO TO 306
RB=0
B=7
BB=15
C LATER ADD CHECK FOR HEIGHT OF NOTES UNDER 8va.
306 X=RA-200
C MAKES ZERO OR -1 OR 8 IN P7
RC=RB
C ADDS A NEW ITEM. MP, PP, CRESC., ETC. --CODE 3
305 CALL RNX(A,B,STAFF,C,BB,RC,0,X,0)
C RNX FILLS PARAMS 0→8
IS=IS+NN
IF(B.EQ.3.OR.B.EQ.6)GO TO 230
C B=6=TREM. NN=6=WORDS OR LTRS. UNDER STAFF.
J=J+1
RC=POSIT(VX(J))
IF(RB.EQ.0)RC=RC+3
C RB=0= 8va
RN(IS-2)=RC
C THIS IS P6 (POS2 FOR CRESC. LINES)
514 J=J+1
A=VX(J)
N=A
C SO ITEMS NEED NOT BE IN RIGHT ORDER.
IF(MOD(N,100).GT.IRHY)A=0
IF(A.NE.0)GO TO 505
CC***USE NO NUMBS IN COMMENTS IN MODE 3-5****** IF(VX(J+2).EQ.0)GO TO 614
IF(J.LT.50)GO TO 514
C SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
614 IF(INP(72).NE.ISTAR)GO TO 552
714 IF(INVT)RETURN
INVT=IS
CALL NEWR
IS=INVT
RETURN
552 CALL BMREAD
C TO READ MORE THAN 2 LINES.
GO TO 25
304 RB=R(2,K)
IF(RA.EQ.6)RA=26.
A=RA
IF(RB.EQ.0)GO TO 301
IF(RB.GE.10)GO TO 303
A=A*100
GO TO 301
303 RB=RB*100
301 R(2,K)=RB+A
C P11 INFO(MARKS) IS TEMPORARILY STORED IN P2 (STAFF# IS IN STAFF)
230 A=VX(J)
JREP=-1
IF(A.EQ.0)GO TO 514
C NEXT FOR STRING OF SAME MARK ( /3 12 S/ )
IF(A.GT.JNTC)A=JNTC
C WON'T PUT MARK BEYOND LAST NOTE
JREP=0
J=J-1
VX(J)=VX(J)+1
IF(VX(J).GE.A)VX(J+1)=0
J=J-1
GO TO 514
C USES 4-7,9,11-13 FOR ACC. > FERM. DOT - DNBOW UPBOW HARM.
C NOTE#,ACCENT#/N,A/N,A*
END
SUBROUTINE XREAD
COMMON /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72)
1 /SCX/JALPHA(7),ISTAR,JAL(22),JX,U,JZ,IRHY,JD,KA,KB,IZ
1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
1 ,JXX,ISEMI,IQT,VX(50),IAMP,K
DO 1500 K=1,72
IF(INP(K).EQ.ISTAR)GO TO 15
1500 IF(INP(K).EQ.ISEMI)GO TO 500
15 INP(72)=ISTAR
C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
C ******* 1ST MAIN LOOP *********
500 REREAD F78F,VX
J=0
IF(IREAD.EQ.-1)J=1
C SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
J=J+1
N=VX(J)
END
FUNCTION ZNOTE(K)
C ADJUSTS HEIGHT IN RE. TO STAFF ABOVE OR BELOW AND SPECIFIED STEM DIR.
COMMON /SCX/JALPHA(30),X /RINP/R(10,85)
1 /RMOD/RMODE2,SET4,IBEAM,NOSET,STEM,STUP,NTC,PS2,RAM,JSTEM
ZNOTE=XNOTE(K)
IF(JSTEM.GT.K)RETURN
L=R(10,K)
IF(L.EQ.0)RETURN
M=X/10.
IF(M.EQ.0)RETURN
IF(M.EQ.L)RETURN
M=R(5,K)/10.
C ASSUMES SPECIFIED STEM DIR. IS CORRECT
A=0
IF(L.EQ.1)GO TO 1
IF(M.EQ.2)A=-14.
GO TO 2
1 IF(M.EQ.1)A=14.
2 ZNOTE=ZNOTE+A
END
SUBROUTINE MARKS(RA)
COMMON/ALF/INP(72),ML /JCHAR/IXX,ISEMX,IBLA
1 /MKS/MKS(14) /MKX/KSLA,ISEMI,NONO(7),MINUS,ISTAR
1 /A2Z/A1(4),LEE,A2(6),LEL,LMM,LNN,A3(11),LZZ
1 /SCX/ICOM,MINU,IDOT,IEQ,LPRN,IRPRN,IPLUS
1 /SC/J,NO(15),VX(50)
EQUIVALENCE (MF,MKS(3)),(MH,MKS(9)),(MP,MKS(11)),(MM,MKS(5))
1,(MC,MKS(12)),(MR,MKS(13)),(MI,MKS(10)),(MS,MKS(4))
1,(MO,MKS(14)),(MW,MKS(1))
RA=99
DO 16 JM=1,72
16 IF(INP(JM))GO TO 17
C DIDN'T FIND MORE LETTERS
RETURN
17 N=INP(JM)
ML=INP(JM+1)
M=INP(JM+2)
DO 1 K=1,14
1 IF(N.EQ.MKS(K))GO TO 2
C DID NOT FIND A LETTER
RETURN
C 4=W(EDGE),5=A(CCENT),26=FE(RMATA),7=S(TACCATO),9=T(ENUTO)
C 11=D(OWNBOW), 12=U(PBOW),13=H(ARMONIC),14=PL(US),15=TH(ESIS)
C 16=AR(SIS),17=MO(RDANT)
C 18=I(NVRTD MORD), ---,20=TR(ILL), 21=TRF(LAT), 22=TRS(HARP)
C 23=TRN(ATURAL), >39=PPP, PP, CRESC., ETC.
C 25=HW (HEAVY WEDGE), 80=ACC(EL.) FICTA:5=FLAT, 2=#, 3=NAT.
C 27=TS(TEN.+STAC.) 28=WS(WEDGE+STAC.) 29=AS(ACCENT+STACCATO)
2 GO TO(220,10,12,120,4,11,15,15,15,21,12,80,81,87),K
12 IF(ML.EQ.LEL)GO TO 320
C ↑↑↑ PLUS
IF(N.EQ.MF)GO TO 121
RA=42
IF(ML.NE.MP)GO TO 18
RA=41
IF(M.EQ.MP)RA=40
C FOR P, PP, PPP -- 42, 41, 40
GO TO 18
220 IF(ML.EQ.MS)K=25
C 'WS' = WEDGE+STACCATO =28
GO TO 320
15 IF(ML.EQ.MI)GO TO 82
K=K+1
IF(ML.EQ.MW)K=22
C 'HW' MAKES 25 (EVENTUALLY MAKES CLEF# 44)
120 IF(ML.EQ.MF)GO TO 88
320 K=K+3
8 RA=K
C YOU CAN TYPE # OR NAME OF MARK
18 DO 6 JM=1,72
N=INP(JM)
INP(JM)=IBLA
C BLANKS OUT USED LETTERS
IF(N.EQ.KSLA)RETURN
IF(N.EQ.ISTAR)RETURN
6 IF(N.EQ.ISEMI)RETURN
4 IF(ML.EQ.MO)GO TO 20
RA=43
IF(ML.EQ.MF)RA=50
C ↑↑↑↑↑ MP, MF
GO TO 18
121 IF(ML.EQ.LEE)GO TO 320
C ↑↑↑ FERMATA
RA=51
IF(ML.EQ.MF)RA=52
IF(ML.EQ.MP)RA=54
IF(M.EQ.MF)RA=53
C F, FF, FFF, FP -- 51, 52, 53, 54 --- SF=45, SFZ=92
IF(ML.NE.MI)GO TO 22
C TYPE FIF, FIS, FIN FOR FICTA flat, sharp, natural
RA=1
IF(M.EQ.MS)RA=2
IF(M.EQ.LNN)RA=3
GO TO 18
22 M=NALF(ML)
IF(M)GO TO 18
IF(M.LE.5)RA=30+M
C TYPE /2 F0/6 F5/ FOR FINGERING NUMS. 0-5
GO TO 18
88 RA=45
C FOR SF AND SFZ
IF(INP(JM+2).EQ.LZZ)RA=92
GO TO 18
10 IF(ML.EQ.MC)GO TO 84
C 'AC'=ACCEL.
IF(ML.EQ.MR)K=13
C 'AR' FOR ARSIS
IF(ML.EQ.MS)K=26
C 'AS'=ACCENT-STACCATO COMBO (=29)
GO TO 320
11 IF(ML.EQ.MH)K=12
C THESIS
IF(ML.NE.MM)GO TO 110
K=60
IF(M.EQ.LEE)K=58
IF(M.EQ.MS)K=59
C TM=TREMOLO,3 BEAMS=63 AT LABEL 8
C TME, TMS: 61=1 BEAM, 62=2 BEAMS
110 IF(ML.NE.MR)GO TO 111
K=17
C TR(ILL)=20 TRF(LAT)=21 TRS(HARP)=22 TRN(ATRL)=23
IF(M.EQ.MF)K=18
IF(M.EQ.MS)K=19
IF(M.EQ.LNN)K=20
GO TO 320
111 IF(ML.EQ.MS)K=24
C TS=TEN.+STAC.=27
GO TO 320
20 K=17
GO TO 8
21 K=18
GO TO 8
CC80 IF(ML.EQ.IPLUS)GO TO 85
CC IF(ML.EQ.MINUS)GO TO 86
C FOR /N1 C+ N2/ ETC. -- CRESC. AND DECRESC. LINES.
C '+' IS OPTIONAL. 2ND NUM. MEANS NOT 'CRESC.'
80 IF(ML.EQ.MINUS)GO TO 86
CX IF(ML.NE.MR)GO TO 85
IF(VX(J+2).NE.0)GO TO 85
RA=70
C 'CR'='CRESC.'
GO TO 18
85 RA=200
GO TO 18
86 RA=199
GO TO 18
87 RA=208
GO TO 18
C ↑↑↑ FOR /N1 OT N2/ 8va
81 RA=37
C RIT.
GO TO 18
82 RA=82
C DIM.
GO TO 18
84 RA=80
C ACCEL.
GO TO 18
END